(*___________________________________________________________________________*)
(*                                                                           *)
(*                           ARBRE LEXICAL                                   *)
(*___________________________________________________________________________*)





(* declaration des types *)
type noeud_lex = Lettre of char * int * arbre_lex 
	and  arbre_lex = noeud_lex  list

type mot = (string * int)

let explode s =
	let rec f acc = function
		| -1 -> acc
		| k -> f (s.[k] :: acc) (k - 1)
in f [] (String.length s - 1)

let premier l = match l with
	 e::l -> e
	|_ -> failwith "Liste vide"

let depiler l = match l with 
	 e::l -> l 
	|_ -> failwith "Liste vide"

let string_of_char n = String.make 1 n

let rec print_liste = function
	[] -> ()
	|e::l -> Printf.printf "%s\n" e	; print_liste l

let max m1 m2 = match m1,m2 with
	 (w1,n1),(_,n2) when n1 >= n2 -> (w1,n1)
	|(_,_),(w2,n2) -> (w2,n2)

let rec remove x liste = match liste with
	 [] -> failwith "Wtf ?"
	|(w1,n1)::l when (w1,n1) = x -> l
	|e::l -> e::remove x l 

let rec get_max = function
	 [] -> ("",0)
	|e::l -> max e (get_max l)  

let rec trier_liste l = match l with
	 [] -> []
	|l -> let x = get_max l in x :: trier_liste (remove x l)

let rec create_liste = function
	 [] -> []
	|(w,n)::l -> w :: create_liste l

(* tester si un mot appartient au dictionnaire *)
let rec existe m d = 
	let aux sm i n = match d with
		[] -> false
		| (Lettre (c,b,l))::q when c=sm.[i] -> 
			if n = 1 then (b<>0) else existe (String.sub sm (i+1) (n-1)) l       
		| (Lettre (c,b,l))::q -> existe sm q
	in aux m 0 (String.length m)

let rec exist x d = match d with
	 [] -> false
	|Lettre (a,_,_)::l2 when a = x -> true
	|Lettre(_,_,_)::l2 -> exist x l2

let rec find x = function
	 [] -> failwith "Pas trouve, wtf, exist avait renvoye true"
	|Lettre(a,_,l)::l2 when a = x -> l
	|Lettre(_,_,_)::l2 -> find x l2

let recherche m d =
	let word = explode m in
		let rec doIt d = function
			 [] -> d
	 		|e::l when exist e d -> doIt (find e d) l
			|_ -> []
		in doIt d word 

(* ajouter un mot au dictionnaire *)
let rec ajoute m d = 
	let aux sm i n = 
		if n = 0 then d 
		else match d with 
			 [] -> [Lettre (sm.[i], (if (n = 1) then 1 else 0), ajoute (String.sub sm (i+1) (n-1)) [])]
			| (Lettre(c,b,l))::q when c=sm.[i]-> 
				if n = 1 then (Lettre(c,b+1,l))::q
				else Lettre(c,b,ajoute (String.sub sm (i+1) (n-1)) l)::q
			| (Lettre(c,b,l))::q -> (Lettre(c,b,l))::(ajoute sm q)
	in aux m 0 (String.length m)

(*construire un dictionnaire a partir d'une liste de mots *)
let construit l = 
	let rec aux l d = match l with 
		[] -> d
		| t::q -> aux q (ajoute t d) 
	in aux l []

(* liste de mots * dictionnaire -> liste de mots appartenant au dictionnaire *)
let rec filter p = function 
	[] -> []
	| t::q -> if p t then t::(filter p q) else filter p q

let verifie l d = filter (function x -> existe x d) l
(*
let afficher pile = 
	let piletmp = ref [] and piletmp2 = ref pile in
		while (!piletmp2 <> [] & ((premier !piletmp2) <> '~')) do
			begin
			piletmp := (premier !piletmp2)::!piletmp;
			piletmp2 := depiler !piletmp2
			end		
		done;
		while (!piletmp <> []) do
			begin
			Printf.printf "%c" (premier !piletmp);
			piletmp := depiler !piletmp
			end 
		done;
	Printf.printf "\n"*)

let get_pile pile = 
	let piletmp = ref pile and word = ref "" in
		while (!piletmp <> [] & ((premier !piletmp) <> '~')) do
			begin
			word := string_of_char (premier !piletmp) ^ !word;
			piletmp := depiler !piletmp
			end		
		done;
		!word
	

let pile = ref []
let liste = ref []

let rec print = function
	|Lettre (x, b, []) when b <> 0 -> pile := x::!pile; liste := (get_pile !pile,b)::!liste;pile := depiler !pile
	|Lettre (x, 0, []) -> ()
	|Lettre (x, b, l) when b <> 0 ->  pile := x::!pile; liste := (get_pile !pile,b)::!liste; pile := depiler !pile; print (Lettre (x, 0, l))
	|Lettre (x, 0, e::l) ->  pile := x::!pile; print e; pile := depiler !pile; print (Lettre(x, 0, l))
	|_ -> failwith " Probleme chelou, a voir"

let liste_mots = List.rev ["and"; "as" ; "assert"; "begin"; "class"; "constraint"; "do"; "done"; "downto"; "else"; "end"; "exception"; "external"; "false"; "for"; "fun"; "function"; "functor"; "if"; "in"; "include"; "inherit"; "initializer";"lazy"; "let"; "match"; "method"; "module"; "mutable"; "new"; "object"; "of"; "open"; "or"; "private"; "rec"; "sig"; "struct"; "then"; "to"; "true"; "try"; "type"; "val"; "virtual"; "when"; "while"; "with"]

let arbre = ref (construit liste_mots)

let _ = arbre := recherche "pri" !arbre; print (Lettre ('~',0,!arbre)); print_liste (create_liste(trier_liste (!liste)))
